home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / rdkybd.zip / RDKYBDEM.PAS < prev   
Pascal/Delphi Source File  |  1993-01-04  |  8KB  |  289 lines
  1.  
  2. program Rdkybdem;              {demo for Turbo Pascal 4.0 Rdkybd unit}
  3.  
  4. {John Haluska, CIS 74000,1106}
  5.  
  6. uses Crt,Rdkybd;
  7.  
  8. var
  9.   Select  : char;
  10.  
  11. procedure ErrorToneTest;
  12. var
  13.   Ch  : char;
  14.   X,Y  : byte;
  15. begin
  16.   Writeln(#13,#10,'A:  procedure ErrorTone;');
  17.   Writeln('    Enter character:  1   : Generate ErrorTone (if enabled)');
  18.   Writeln('                      2   : Enable ErrorTone');
  19.   Writeln('                      3   : Disable ErrorTone');
  20.   Writeln('                      ESC : Exit this test',#13,#10);
  21.   X := WhereX; Y := WhereY;
  22.   repeat
  23.     Ch := ReadKey;
  24.     GotoXY(X,Y);
  25.     case Ch of
  26.       '1'  :  begin
  27.                 Write('1:  Generate ErrorTone (if enabled)    ');
  28.                 ErrorTone;
  29.               end;
  30.       '2'  :  begin
  31.                 Write('2:  Enable ErrorTone                   ');
  32.                 ErrorToneEnb := True;
  33.               end;
  34.       '3'  :  begin
  35.                 Write('3:  Disable ErrorTone                  ');
  36.                 ErrorToneEnb := False;
  37.               end;
  38.       #27  : ;                       {Esc}
  39.       #0   :  begin                  {Extended key}
  40.                 Write('Invalid key                            ');
  41.                 Ch := ReadKey;
  42.               end;
  43.       else  Write('Invalid key                            ');
  44.       end;
  45.   until Ch = #27;                     {Esc}
  46.   Writeln;
  47. end;
  48.  
  49. procedure PasswordTest;
  50. var
  51.   S  : string;
  52. begin
  53.   Writeln('B: procedure Password : string;');
  54.   Write('  Enter password:  ');
  55.   Password(S);
  56.   Writeln;
  57.   Writeln(' The Password entered is:  ',S);
  58. end;
  59.  
  60. procedure ReadByteTest;
  61. var
  62.   N   : byte;
  63.   Ch  : char;
  64.   X,Y : byte;
  65. begin
  66.   Writeln('C: procedure ReadByte : byte;  Only valid bytes accepted.');
  67.   Writeln('   Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
  68.   Writeln;
  69.   repeat
  70.     X := WhereX; Y := WhereY;
  71.     Write(' Enter number: ');
  72.     ReadByte(N);
  73.     GotoXY(X+35,Y);
  74.     Writeln('Press ESC to quit, any other key to repeat.');
  75.     Ch := ReadKey;
  76.   until Ch = #27;
  77. end;
  78.  
  79. procedure ReadIntgrTest;
  80. var
  81.   N   : integer;
  82.   Ch  : char;
  83.   X,Y : byte;
  84. begin
  85.   Writeln('D: procedure ReadIntgr : integer;  Only valid integers accepted.');
  86.   Writeln('   Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
  87.   Writeln;
  88.   repeat
  89.     X := WhereX; Y := WhereY;
  90.     Write(' Enter number: ');
  91.     ReadIntgr(N);
  92.     GotoXY(X+35,Y);
  93.     Writeln('Press ESC to quit, any other key to repeat.');
  94.     Ch := ReadKey;
  95.   until Ch = #27;
  96. end;
  97.  
  98. procedure ReadLongIntTest;
  99. var
  100.   N   : longint;
  101.   Ch  : char;
  102.   X,Y : byte;
  103. begin
  104.   Writeln('E: procedure ReadLongInt : longint;');
  105.   Writeln('   Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
  106.   Writeln;
  107.   repeat
  108.     X := WhereX; Y := WhereY;
  109.     Write(' Enter number: ');
  110.     ReadLongInt(N);
  111.     GotoXY(X+35,Y);
  112.     Writeln('Press ESC to quit, any other key to repeat.');
  113.     Ch := ReadKey;
  114.   until Ch = #27;
  115. end;
  116.  
  117. procedure ReadByteMinMaxTest;
  118. var
  119.   P,Q,N,Temp  : byte;
  120.   Ch     : char;
  121. begin
  122.   Writeln('F: procedure ReadByteMinMax(Min,Max : byte) : byte;');
  123.   Writeln('   Only valid bytes in range min to max accepted.');
  124.   Writeln('   Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
  125.   Writeln;
  126.   repeat
  127.     Write('   Enter min byte:    ');
  128.     ReadByte(P);
  129.     Write('         ');
  130.     Write('   Enter max byte:    ');
  131.     ReadByte(Q);
  132.     Write (#10,#13,'   Enter sample byte: ');
  133.     ReadByteMinMax(P,Q,N);
  134.     Writeln(#10,#13,'   Press ESC to quit, any other key to repeat.');
  135.     Ch := ReadKey;
  136.     Writeln;
  137.   until Ch = #27;
  138. end;
  139.  
  140. procedure ReadIntgrMinMaxTest;
  141. var
  142.   P,Q,N  : integer;
  143.   Ch     : char;
  144. begin
  145.   Writeln('G: procedure ReadIntgrMinMax(Min,Max : integer) : integer;');
  146.   Writeln('   Only valid integers in range min to max accepted.');
  147.   Writeln('   Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
  148.   Writeln;
  149.   repeat
  150.     Write('   Enter min integer:    ');
  151.     ReadIntgr(P);
  152.     Write('         ');
  153.     Write('   Enter max integer:    ');
  154.     ReadIntgr(Q);
  155.     Write (#10,#13,'   Enter sample integer: ');
  156.     ReadIntgrMinMax(P,Q,N);
  157.     Writeln(#10,#13,'   Press ESC to quit, any other key to repeat.');
  158.     Ch := ReadKey;
  159.     Writeln;
  160.   until Ch = #27;
  161. end;
  162.  
  163. procedure ReadLongIntMinMaxTest;
  164. var
  165.   P,Q,N  : longint;
  166.   Ch     : char;
  167. begin
  168.   Writeln('H: procedure ReadLongIntMinMax(Min,Max : longint) : longint;');
  169.   Writeln('   Only valid longintegers in range min to max accepted.');
  170.   Writeln('   Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
  171.   Writeln;
  172.   repeat
  173.     Write('   Enter min longinteger: ');
  174.     ReadLongInt(P);
  175.     Write('     ');
  176.     Write('   Enter max longinteger: ');
  177.     ReadLongInt(Q);
  178.     Write (#10,#13,'   Enter longinteger:     ');
  179.     ReadLongIntMinMax(P,Q,N);
  180.     Writeln(#10,#13,'   Press ESC to quit, any other key to repeat.');
  181.     Ch := ReadKey;
  182.     Writeln;
  183.   until Ch = #27;
  184. end;
  185.  
  186. procedure ReadRealTest;
  187. var
  188.   R  : real;
  189.   Ch : char;
  190. begin
  191.   Writeln('I: procedure RealReal : real;  Only valid real numbers accepted');
  192.   Writeln('   Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
  193.   Writeln;
  194.   repeat
  195.     Write(' Enter any number: ');
  196.     ReadReal(R);
  197.     Writeln;
  198.     Writeln('Press ESC to quit, any other key to repeat.');
  199.     Ch := ReadKey;
  200.     Writeln;
  201.   until Ch = #27;
  202. end;
  203.  
  204. procedure ReadRealMinMaxTest;
  205. var
  206.   X,Y,Z  : real;
  207.   Ch     : char;
  208. begin
  209.   Writeln('J: procedure ReadRealMinMax(Min,Max : real) : real; ');
  210.   Writeln('   Only valid reals in range min to max accepted.');
  211.   Writeln('   Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
  212.   Writeln;
  213.   repeat
  214.     Write('   Enter min real: ');
  215.     ReadReal(X);
  216.     Writeln;
  217.     Write('   Enter max real: ');
  218.     ReadReal(Y);
  219.     Write (#10,#13,'   Enter sample real: ');
  220.     ReadRealMinMax(X,Y,Z);
  221.     Writeln(#10,#13,'   Press ESC to quit, any other key to repeat.');
  222.     Ch := ReadKey;
  223.     Writeln;
  224.   until Ch = #27;
  225.   Writeln;
  226. end;
  227.  
  228. procedure ReadStringTest;
  229. var
  230.   S   : string;
  231.   Ch  : char;
  232. begin
  233.   Writeln('K: procedure ReadString : string;');
  234.   Writeln('   Edit entry with Left, Right, Home, End, Del, Bksp, Esc keys.');
  235.   Writeln;
  236.   repeat
  237.     Write('   Enter string: ');
  238.     ReadString(S);
  239.     Writeln(#13,#10,'   Press ESC to quit, any other key to repeat.');
  240.     Ch := ReadKey;
  241.   until Ch = #27;
  242. end;
  243.  
  244. begin
  245.   ClrScr;
  246.   repeat
  247.     Writeln;
  248.     Write ('Enter: (M) Menu, (Q) Quit, or Test Selection Letter: ');
  249.     Select := ReadKey;
  250.     if Select <> #0 then
  251.       begin
  252.         Select := UpCase(Select);
  253.         Writeln (Select);
  254.       end
  255.     else Select := Readkey;
  256.     Writeln;
  257.     case Select of
  258.     'M' : begin
  259.             ClrScr;
  260.             Writeln('                     Turbo Pascal 4.0 Rdkybd Unit Demo');
  261.             Writeln;
  262.             Writeln('  A   ErrorTone');
  263.             Writeln('  B   Password');
  264.             Writeln('  C   ReadByte');
  265.             Writeln('  D   ReadIntgr');
  266.             Writeln('  E   ReadLongInt');
  267.             Writeln('  F   ReadByteMinMax');
  268.             Writeln('  G   ReadIntgrMinMax');
  269.             Writeln('  H   ReadLongIntMinMax');
  270.             Writeln('  I   ReadReal');
  271.             Writeln('  J   ReadRealMinMax');
  272.             Writeln('  K   ReadString');
  273.           end;
  274.     'A' : ErrorToneTest;
  275.     'B' : PasswordTest;
  276.     'C' : ReadByteTest;
  277.     'D' : ReadIntgrTest;
  278.     'E' : ReadLongIntTest;
  279.     'F' : ReadByteMinMaxTest;
  280.     'G' : ReadIntgrMinMaxTest;
  281.     'H' : ReadLongIntMinMaxTest;
  282.     'I' : ReadRealTest;
  283.     'J' : ReadRealMinMaxTest;
  284.     'K' : ReadStringTest;
  285.     'Q' : ;
  286.     end;
  287.   until Select = 'Q';
  288. end.
  289.